home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MYUTIL / PRGLOAD.M < prev    next >
Encoding:
Text File  |  1991-02-21  |  19.8 KB  |  587 lines
  1.  
  2. MODULE PrgLoad;
  3.  
  4. (*
  5.  * Hinweis/Copyright:
  6.  * ------------------
  7.  *   Die Verwendungsrechte dieses Programms und seiner Quellen in der
  8.  *   vorliegenden Version 2.0 liegt bei der Zeitschrift TOS (ICP-Verlag,
  9.  *   Vaterstetten). Ein Verkauf dieses Programms oder seiner Quellen
  10.  *   getrennt von den Zeitschriften des ICP-Verlags ist jedoch nicht
  11.  *   gestattet.
  12.  *
  13.  *   Mit Erwerb der Zeitschrift "TOS" steht es Ihnen frei, das Programm
  14.  *   zu nutzen. Das Programm ist also keine Freeware oder PD!
  15.  *   Sie dürfen das Programm verändern, jedoch nicht selbst "verbesserte"
  16.  *   Versionen dieses Programms verbreiten. Dies obliegt allein dem Urheber
  17.  *   Thomas Tempelmann.
  18.  *
  19.  *   Ich hoffe, Sie beachten diese Hinweise. Ich wäre schwer enttäuscht,
  20.  *   wenn plötzlich eine Version 2.1, die nicht von mir stammt, auf
  21.  *   dem PD- oder Raubkopiermarkt erscheint. Dann könnte dies der letzte
  22.  *   Beitrag von mir gewesen sein. Fairness und Vertrauen sind wichtig
  23.  *   für das Weiterleben dieser Form der Softwareveröffentlichung!
  24.  *
  25.  *   Für Fragen, Wünsche, Verbesserungen und Veröffentlichungen wenden
  26.  *   Sie sich bitte an den Autor:
  27.  *      Thomas Tempelmann, Nordendstr. 64, D-8000 München 40.
  28.  *
  29.  * Über dieses Programm:
  30.  * ---------------------
  31.  *   In der Ausgabe 4/91 der Zeitschrift TOS finden Sie die ausführliche
  32.  *   Beschreibung dieses nützlichen Programms.
  33.  *
  34.  *   Dieses Modul ist ohne Änderungen nur mit Megamax Modula-2 (System 2.2,
  35.  *   Compiler 4.0) oder höher übersetzbar. Desweiteren gehören die beiden
  36.  *   Quellen des Moduls "PrgLoader" (PRGLOADE.D & PRGLOADE.I) zu diesem
  37.  *   Programm und müssen zuvor übersetzt werden.
  38.  *
  39.  *   Zum Linken reicht ein kleiner Stack, z.B. 4000 Byte.
  40.  *   Als Treibermodule ist lediglich "M2Init" einzubinden.
  41.  *
  42.  * Mögliche Verbesserungen:
  43.  * ------------------------
  44.  * - Überwachen, ob "UsedHeapSize" bei jedem Programmlauf gleich bleibt.
  45.  * - Selbstmodifizierenden Code erkennen und dann Warnung anzeigen mit
  46.  *   Option, das Programm freizugeben.
  47.  *
  48.  *----------------------------------------------------------------------------
  49.  * 22.10.88  TT  Grunderstellung ModLoad
  50.  * 21.12.88  TT  Fertigstellung der Version 1.0 aus ModLoad 1.0
  51.  * 05.02.91  TT  Fertigstellung der Version 2.0 aus ModLoad 1.3
  52.  *----------------------------------------------------------------------------
  53.  *)
  54.  
  55. (*$E MAC  -> Linker erzeugt ACC-Endung *)
  56. (*$R-,S-  -> Keine Bereichs-, Überlauf- und Stack-Prüfungen erzeugen *)
  57.  
  58. FROM PrgLoader IMPORT
  59.   QueryLoaded, LoadProgram, UnLoadProgram, ProgramLoaded, CallProgram,
  60.   UsedHeapSize, LoaderResults, ArgStr;
  61.  
  62. FROM SYSTEM IMPORT
  63.   ASSEMBLER, CAST, ADDRESS, ADR, TSIZE, BYTE, WORD, LONGWORD;
  64.  
  65. FROM AESWindows IMPORT
  66.   UpdateWindow;
  67.  
  68. FROM AESForms IMPORT
  69.   FormAlert;
  70.  
  71. FROM AESMisc IMPORT
  72.   ShellFind;
  73.  
  74. FROM AESMisc IMPORT
  75.   SelectFile;
  76.  
  77. FROM EasyGEM0 IMPORT
  78.   WrapAlert;
  79.  
  80. FROM MOSGlobals IMPORT
  81.   PathStr, NameStr, FileStr, SfxStr, MemArea;
  82.  
  83. FROM FileNames IMPORT
  84.   FileName, PathConc, SplitPath, SplitName;
  85.  
  86. FROM Files IMPORT
  87.   File, Open, Close, EOF, State, Access;
  88.  
  89. FROM Text IMPORT
  90.   EOL, ReadFromLine, ReadLn;
  91.  
  92. FROM StrConv IMPORT
  93.   CardToStr, StrToLCard;
  94.  
  95. FROM GEMEnv IMPORT
  96.   GemError, InitApplication, ExitApplication;
  97.  
  98. FROM AESEvents IMPORT
  99.   MessageEvent, MessageBuffer, accOpen;
  100.  
  101. FROM AESMenus IMPORT
  102.   RegisterAcc;
  103.  
  104. FROM PrgCtrl IMPORT
  105.   Accessory;
  106.  
  107. FROM MOSCtrl IMPORT
  108.   ProcessID (* Zeiger auf den aktuellen GEMDOS-Prozeß *);
  109.  
  110. FROM SysInfo IMPORT
  111.   UseStackFrame;
  112.  
  113. FROM Directory IMPORT
  114.   GetDefaultPath;
  115.  
  116. IMPORT FuncStrings, Strings, XBRA, BIOS;
  117.  
  118.  
  119. CONST   LoaderStackSize = 4000; (* Stackgröße zum Aufruf des Loaders *)
  120.  
  121.         Kennung = 'PrgL';       (* XBRA-Kennung für TRAP #1-Handler *)
  122.         PrgName = 'PrgLoad';    (* Name dieses Moduls (auch ACC-Eintrag) *)
  123.         Version = '2.0';        (* Nicht ändern und veröffentlichen (s.o.)! *)
  124.         InfName = 'PRGLOAD.INF';(* Name der INF-Datei *)
  125.  
  126.  
  127. TYPE ptrArgStr = POINTER TO ArgStr;
  128.  
  129.      PtrPexecPar = POINTER TO RECORD
  130.                      mode: (loadExec, unused1, unused2, load, exec, create);
  131.                      fileName: ADDRESS;
  132.                      arg: ptrArgStr;
  133.                      env: ADDRESS
  134.                    END;
  135.  
  136. VAR
  137.   DefaultHeap: LONGCARD;    (* Heap-Größe, wenn keine andere Angabe *)
  138.   DidShowInfo, GotHeapSize, GetHeapSize: BOOLEAN;
  139.   Desktop: ADDRESS;         (* Prozeßkennung des Desktops, invariabel *)
  140.  
  141.   myName: Strings.String;
  142.   path: ARRAY [0..127] OF CHAR;
  143.  
  144.   entry, at: ADDRESS;
  145.   carrier: XBRA.Carrier;
  146.   stackhi: ADDRESS;
  147.   doingPexec: BOOLEAN;
  148.   stackFrameOffs: SHORTCARD;
  149.   ok: BOOLEAN;
  150.  
  151.  
  152. PROCEDURE Alert (s: ARRAY OF CHAR);
  153. (*
  154.  * Einen beliebigen Hinweistext als Alert-Meldung anzeigen.
  155.  *)
  156.  
  157.   VAR button: CARDINAL;
  158.       ok: BOOLEAN;
  159.       msg: ARRAY [0..250] OF CHAR;
  160.  
  161.   BEGIN
  162.     Strings.Assign (s, msg, ok);
  163.     (* Meldung mit FormAlert-Dialog anzeigen *)
  164.     WrapAlert (msg, 0);
  165.     Strings.Insert ('[0][', 0, msg, ok);
  166.     Strings.Append ('][ OK ]', msg, ok);
  167.     FormAlert (1, msg, button);
  168.   END Alert;
  169.  
  170. PROCEDURE doLoadWithMsg (REF name: ARRAY OF CHAR);
  171. (*
  172.  * Das Programm laden und dann eine Erfolgs- bzw. Fehlermeldung anzeigen
  173.  *)
  174.   VAR result: LoaderResults;
  175.       msg: ARRAY [0..60] OF CHAR;
  176.   BEGIN
  177.     IF ProcessID^ # Desktop THEN
  178.       Alert ("Das Laden ist nur vom Desktop aus möglich!")
  179.     ELSE
  180.       SplitPath (name, path, msg); (* 'msg' enthält nun den Programmnamen *)
  181.       LoadProgram (name, DefaultHeap, result);
  182.       IF result = noError THEN
  183.         Strings.Append (' wurde geladen', msg, ok)
  184.       ELSIF result = alreadyLoaded THEN
  185.         Strings.Append (' ist bereits geladen', msg, ok)
  186.       ELSE
  187.         Strings.Append (' kann nicht geladen werden', msg, ok)
  188.       END;
  189.       Alert (msg)
  190.     END;
  191.   END doLoadWithMsg;
  192.  
  193. PROCEDURE doUnLoadWithMsg (REF name: ARRAY OF CHAR);
  194. (*
  195.  * Programm freigeben und Meldung anzeigen
  196.  *)
  197.   VAR result: LoaderResults;
  198.       msg: ARRAY [0..50] OF CHAR;
  199.   BEGIN
  200.     SplitPath (name, path, msg);
  201.     UnLoadProgram (name, result);
  202.     IF result = noError THEN
  203.       Strings.Append (' wurde freigegeben', msg, ok);
  204.     ELSE
  205.       Strings.Append (' war nicht geladen', msg, ok)
  206.     END;
  207.     Alert (msg)
  208.   END doUnLoadWithMsg;
  209.  
  210. PROCEDURE hdlPexec (par: PtrPexecPar; VAR exitCode: LONGINT): BOOLEAN;
  211. (*
  212.  * Diese Routine wird von 'hdlGemdos' aufgerufen, wenn die
  213.  * Pexec-Funktion des GEMDOS von einem Programm aufgerufen
  214.  * wird. Hier wird geprüft, ob das Programm schon geladen
  215.  * ist, um es dann aus dem Speicher statt von Disk zu starten.
  216.  * In 'par' wird ein Zeiger auf die Parameter des Pexec-Aufrufs
  217.  * übergeben; 'hdlPexec' muß FALSE zurückgeben, wenn am Ende
  218.  * doch das GEMDOS die Pexec-Funktion ausführen soll, andernfalls
  219.  * muß sie in 'exitCode' den Fehlercode liefern.
  220.  *)
  221.  
  222.   VAR fn: POINTER TO FileStr;
  223.       result: LoaderResults;
  224.  
  225.   BEGIN (* hdlPexec *)
  226.     fn:= par^.fileName;
  227.     IF par^.mode = loadExec (*trifft immer zu, da schon vorher geprüft*) THEN
  228.       IF (ProcessID^ = Desktop) & (BIOS.ControlKey IN BIOS.GetKBShift ()) THEN
  229.         (* Das Laden ist nur vom Desktop aus erlaubt! *)
  230.         IF BIOS.LeftShift IN BIOS.GetKBShift () THEN
  231.           (* Mit Shift&Control kann Programm wieder freigegeben werden *)
  232.           doUnLoadWithMsg (fn^)
  233.         ELSE
  234.           (* Mit Control-Taste wird Programm geladen und nicht gestartet *)
  235.           doLoadWithMsg (fn^)
  236.         END;
  237.         exitCode:= 0;
  238.         RETURN TRUE
  239.       ELSE
  240.         IF GetHeapSize OR ProgramLoaded (fn^) THEN
  241.           (* hier normalerweise nur geladene Programme starten; nicht
  242.            * geladene Programme unimttelbar über GEMDOS starten lassen,
  243.            * um evtl. Seiteneffekte zu vermeiden. *)
  244.           GotHeapSize:= TRUE;
  245.           CallProgram (fn^, par^.arg^, par^.env, exitCode);
  246.           RETURN TRUE
  247.         END
  248.       END;
  249.     END;
  250.     RETURN FALSE
  251.   END hdlPexec;
  252.  
  253. VAR regStack: ARRAY [1..256] OF WORD; (* Stack für Register-Sicherung (½KB) *)
  254.  
  255. PROCEDURE hdlGemdos;
  256. (*
  257.  * Diese Funktion hängt im GEMDOS-TRAP-Handler und überwacht, ob
  258.  * die Pexec-Funktion aufgerufen wird. Wenn nicht, wird die Kontrolle
  259.  * normal ans GEMDOS weitergereicht, sonst wird 'hdlPexec' aufgerufen.
  260.  *)
  261.   (*$L-  -> keinen Modula-Eintrittscode erzeugen *)
  262.   BEGIN
  263.     ASSEMBLER
  264.         BTST.B  #5,(A7)         ; War Supervisormode aktiv ?
  265.         BNE.B   super           ; Ja, dann stehen Arg. auf SSP
  266.         MOVE.L  USP,A0
  267.         CMPI.W  #$4B,(A0)       ; Pexec - Funktion ?
  268.         BEQ.B   hdlPexecUser
  269. dos     ; normale GEMDOS-Funktion ausführen
  270.         MOVE.L  entry,A0
  271.         MOVE.L  -4(A0),A0
  272.         JMP     (A0)
  273. super   MOVE.W  stackFrameOffs,D0 ; damit es auch mit einer 68010/20/30 geht
  274.         CMPI.W  #$4B,6(A7,D0.W) ; Pexec - Funktion ?
  275.         BNE.B   dos             ; Nein -> GEMDOS aufrufen
  276.         LEA     6(A7,D0.W),A0   ; Basis d. Argumente nach A0
  277. hdlPexecUser:
  278.         TST.W   doingPexec      ; ist dies der "Pexec" von "CallModule"?
  279.         BEQ     noPexec         ;   nein -> dann werten wir ihn selbst aus.
  280.  
  281.         CLR.W   doingPexec
  282.         BRA     dos             ;   ja -> dann lassen wir ihn zum GEMDOS durch
  283.  
  284. noPexec ; prüfen, ob Prg gestartet & ausgeführt werden soll.
  285.         ADDQ.L  #2,A0
  286.         CMPI    #loadExec,PtrPexecPar.mode(A0)
  287.         BNE     dos
  288.  
  289.         MOVE.L  stackhi,A1      ; neuen SP f. Modula-Funktionen laden
  290.         ; Register auf regStack retten:
  291.         MOVEM.L D1-D7/A2-A6,-(A1)
  292.         MOVE.W  (A7)+,-(A1)     ; SR vom SSP retten
  293.         MOVE.L  (A7)+,-(A1)     ; PC vom SSP retten
  294.         TST.W   stackFrameOffs  ; StackFrame vorhanden?
  295.         BEQ     noSF1           ; nein
  296.         MOVE.W  (A7)+,-(A1)     ; StackFrame vom SSP retten
  297. noSF1:  MOVE.L  USP,A2
  298.         MOVE.L  A2,-(A1)        ; USP retten
  299.         MOVE.L  A7,-(A1)        ; SSP retten
  300.         MOVE.L  A1,stackhi
  301.         MOVE.L  A1,USP          ; den regStack auch für Malloc-Aufruf nutzen
  302.         ANDI    #$CFFF,SR       ; User Mode aktivieren
  303.  
  304.         ; Stack f. Modula-Funktionen (Loader-Aufruf) reservieren
  305.         MOVE.L  A0,-(A7)
  306.         MOVE.L  #LoaderStackSize,-(A7)
  307.         MOVE    #$48,-(A7)      ; Malloc()
  308.         TRAP    #1
  309.         ADDQ.L  #6,A7
  310.         MOVE.L  (A7)+,A0
  311.         MOVE.L  D0,A3
  312.         LEA     LoaderStackSize(A3),A7
  313.  
  314.         ; Parameter für 'hdlPexec' auf den Parm-Stack (A3) laden
  315.         MOVE.L  A0,(A3)+        ; Adr. der Parameter übergeben
  316.         LEA     exitCode(PC),A0
  317.         MOVE.L  A0,(A3)+        ; Adr. der exitCode-Variable übergeben
  318.         MOVE    #1,doingPexec   ; Flag gegen Wiedereintritt setzen
  319.         JSR     hdlPexec        ; Pexec-Sonderbehandlung
  320.         CLR.W   doingPexec
  321.         MOVE.W  -(A3),D0        ; Pexec-Rückgabewert (BOOLEAN = 2 Byte)
  322.  
  323.         ; Modula-Stack wieder freigeben
  324.         MOVE.L  stackhi,A7      ; regStack wieder für SP verwenden
  325.         MOVE.L  D0,-(A7)
  326.         MOVE.L  A3,-(A7)
  327.         MOVE    #$49,-(A7)      ; Mfree()
  328.         TRAP    #1
  329.         ADDQ.L  #6,A7
  330.         
  331.         ; zurück in den Supervisor-Mode:
  332.         CLR.L   -(A7)
  333.         MOVE    #$20,-(A7)      ; Super (0L)
  334.         TRAP    #1
  335.         ADDQ.L  #6,A7
  336.         MOVE.L  (A7)+,D0
  337.         
  338.         MOVE.L  A7,A1
  339.         MOVE.L  (A1)+,A7        ; SSP zurück
  340.         MOVE.L  (A1)+,A0        ; USP zurück
  341.         MOVE.L  A0,USP
  342.         TST.W   stackFrameOffs  ; StackFrame vorhanden?
  343.         BEQ     noSF2           ; nein
  344.         MOVE.W  (A1)+,-(A7)     ; StackFrame zurück
  345. noSF2:  MOVE.L  (A1)+,-(A7)     ; PC zurück
  346.         MOVE.W  (A1)+,-(A7)     ; SR zurück
  347.         MOVEM.L (A1)+,D1-D7/A2-A6
  348.         MOVE.L  A1,stackhi
  349.  
  350.         TST.W   D0              ; hdlPexec-Rückgabewert prüfen
  351.         BEQ     dos             ; Wurde nicht ausgeführt -> GEMDOS aufrufen
  352.         
  353.         MOVE.L  exitCode(PC),D0 ; Exitcode laden
  354.         RTE                     ; und zurück zum Aufrufer
  355.  
  356. exitCode: DS    4               ; 4 Byte für Exitcode reservieren
  357.     END
  358.   END hdlGemdos;
  359.   (*$L=*)
  360.  
  361. PROCEDURE readInfFile;
  362.   (*
  363.    * Liest die Datei "MODLOAD.INF" und lädt die darin angegebenen Module.
  364.    *)
  365.   
  366.   VAR f: File;
  367.       s, s2: Strings.String;
  368.       heapValid: BOOLEAN;
  369.       pos: CARDINAL;
  370.       heap: LONGCARD;
  371.       result: LoaderResults;
  372.   
  373.   BEGIN
  374.     s:= InfName;
  375.     ShellFind (s);
  376.     IF NOT GemError () THEN
  377.       Open (f, s, readSeqTxt);
  378.       WHILE NOT EOF (f) DO
  379.         ReadFromLine (f, s);            (* Zeile einlesen *)
  380.         ReadLn (f);                     (* Zeilenende überlesen *)
  381.         (* Den String beim ersten Leerzeichen nach 's' und 's2' auftrennen: *)
  382.         Strings.Split (s, Strings.PosLen (' ', s, 0), s, s2, ok);
  383.         Strings.Upper (s);
  384.         pos:= 0;
  385.         (* Im zweiten Wort ('s2') eine evtl. vorhandene Zahl ermitteln: *)
  386.         heap:= StrToLCard (s2, pos, heapValid);
  387.         IF Strings.StrEqual (s, "HEAP") THEN
  388.           (* Setzen der voreingestellten Heap-Größe *)
  389.           IF heapValid THEN DefaultHeap:= heap END
  390.         ELSE
  391.           (* Wenn hinter dem Programmnamen eine Zahl angegeben ist, dann
  392.            * diese als Heap-Größe, sonst die voreingestellte Größe nehmen
  393.            * und das Programm laden. *)
  394.           IF NOT heapValid THEN heap:= DefaultHeap END;
  395.           LoadProgram (s, heap, result)   (* Programm laden *)
  396.         END
  397.       END;
  398.       Close (f);
  399.     END
  400.   END readInfFile;
  401.  
  402. PROCEDURE service;
  403. (*
  404.  * Dialogroutine des Accessories
  405.  *)
  406.  
  407.   VAR defbut, button: CARDINAL;
  408.       s: ARRAY [0..199] OF CHAR;
  409.       name: NameStr;
  410.       didShow, ok: BOOLEAN;
  411.  
  412.   PROCEDURE showPrg (REF name: ARRAY OF CHAR; noOfRuns: CARDINAL;
  413.                      currentHeapSize, neededHeapSize: LONGCARD): BOOLEAN;
  414.   (*
  415.    * Subroutine, um die geladenen Programme anzuzeigen
  416.    *)
  417.     BEGIN
  418.       s:= "[0][ |";
  419.       Strings.Append (FileName (name), s, ok);
  420.       Strings.Append (" | |", s, ok);
  421.       IF noOfRuns > 0 THEN
  422.         Strings.Append ("Aktuelle Heap-Größe: ", s, ok);
  423.         Strings.Append (CardToStr (currentHeapSize, 0), s, ok);
  424.         Strings.Append (" |", s, ok);
  425.         IF currentHeapSize < neededHeapSize THEN
  426.           (* Wenn zu wenig Heap reserviert wurde, dann dies anzeigen *)
  427.           Strings.Append ("Benötigte Heap-Größe: ", s, ok);
  428.           Strings.Append (CardToStr (neededHeapSize, 0), s, ok)
  429.         END
  430.       ELSE
  431.         Strings.Append ("(Wurde noch nicht gestartet) |", s, ok)
  432.       END;
  433.       Strings.Append (" ][Weiter|Freigabe|Abbruch]", s, ok);
  434.       FormAlert (1, s, button);
  435.       IF button = 2 THEN
  436.         doUnLoadWithMsg (name)
  437.       END;
  438.       didShow:= TRUE;
  439.       RETURN button # 3
  440.     END showPrg;
  441.  
  442.   BEGIN
  443.     IF GetHeapSize THEN
  444.       (* Wenn vorher "Heap-Größe ermitteln" gewählt wurde, dies nun auswerten *)
  445.       GetHeapSize:= FALSE;
  446.       IF NOT GotHeapSize THEN
  447.         Alert ('Sie haben doch noch kein Programm gestartet, oder?')
  448.       ELSIF UsedHeapSize = MAX (LONGCARD) THEN
  449.         Alert ('Das Programm scheint allen verfügbaren Speicher zu belegen')
  450.       ELSE
  451.         s:= '[0][ |Die benötigte Heap-Größe ist: | |';
  452.         Strings.Append (CardToStr (UsedHeapSize,15), s, ok);
  453.         Strings.Append ("| ][ OK ]", s, ok);
  454.         FormAlert (1, s, button);
  455.       END
  456.     END;
  457.     defbut:= 1;
  458.     LOOP
  459.       s:= "[0][         "+PrgName+" "+Version+"|"
  460.              +" |"
  461.              +"Erstellt von Thomas Tempelmann |"
  462.              +"     mit Megamax Modula-2|"
  463.              +"  für das TOS-Magazin (4/91)]"
  464.              +"[Mehr...|Info|Ausgang]";
  465.       IF NOT DidShowInfo THEN
  466.         defbut:= 2
  467.       END;
  468.       FormAlert (defbut, s, button);
  469.       IF button = 3 THEN
  470.         EXIT
  471.       ELSIF button = 2 THEN
  472.         FormAlert (1, "[0][Autor:      |  Thomas Tempelmann  |"
  473.                    +"  Nordendstraße 64|  D-8000 München 40|  West Germany]"
  474.                    +"[ OK ]", button);
  475.         Alert ("PrgLoad "+Version+" ist weder Freeware noch PD! "+
  476.                "Die Verwendungsrechte für diese Version liegen "+
  477.                "beim ICP-Verlag, Vaterstetten. ");
  478.         Alert ("Der Autor behält sich exklusiv vor, "+
  479.                "weitere Versionen zu veröffentlichen.");
  480.         Alert ("Ausführliche Informationen und die Quelltexte "+
  481.                "zu diesem Programm finden Sie "+
  482.                "im TOS-Magazin, Ausgabe 4/91.");
  483.         DidShowInfo:= TRUE
  484.       ELSE (* button = 1 *)
  485.         s:=  "[0][ |Wählen Sie:| Geladene Programme zeigen |"
  486.             +" Heap-Größe ermitteln/setzen | ";
  487.         IF ProcessID^ = Desktop THEN
  488.           (* Das Laden ist nur vom Desktop aus erlaubt! *)
  489.           Strings.Append ("Programm laden", s, ok)
  490.         ELSE
  491.           Strings.Append ("(Laden nur im Desktop möglich)", s, ok)
  492.         END;
  493.         Strings.Append ("][ Zeige | Heap ", s, ok);
  494.         IF ProcessID^ = Desktop THEN
  495.           Strings.Append ("| Lade ", s, ok)
  496.         ELSE
  497.           Strings.Append ("|Abbruch", s, ok)
  498.         END;
  499.         Strings.Append ("]", s, ok);
  500.         FormAlert (1, s, button);
  501.         IF button = 3 THEN
  502.           IF ProcessID^ = Desktop THEN
  503.             name:= '';
  504.             GetDefaultPath (path);
  505.             SelectFile (path, name, ok);
  506.             IF ok & (name[0] # '') THEN
  507.               doLoadWithMsg (PathConc (path, name));
  508.             END
  509.           END
  510.         ELSIF button = 1 THEN
  511.           didShow:= FALSE;
  512.           QueryLoaded (showPrg);
  513.           IF NOT didShow THEN
  514.             Alert ("Es ist kein Programm geladen.")
  515.           END
  516.         ELSE
  517.           FormAlert (1, "[0][Wählen Sie:|"
  518.                              +" Heap-Größe setzen|"
  519.                              +" Benutzte Heap-Größe|"
  520.                              +"  eines Programms ermitteln | ]"
  521.                              +"[Setzen|Ermitteln]", button);
  522.           IF button = 2 THEN
  523.             Alert ("Starten Sie nun ein Programm und melden Sie sich dann zurück.");
  524.             GotHeapSize:= FALSE;
  525.             GetHeapSize:= TRUE;
  526.             RETURN
  527.           ELSE
  528.             LOOP
  529.               s:= "[0][Voreingestellte Heap-Größe |"
  530.                  +"zum Laden von Programmen:| |";
  531.               Strings.Append (CardToStr (DefaultHeap, 15), s, ok);
  532.               Strings.Append ("| ][Mehr|Weniger|OK]", s, ok);
  533.               FormAlert (3, s, button);
  534.               IF button = 1 THEN
  535.                 DefaultHeap:= DefaultHeap + DefaultHeap DIV 2
  536.               ELSIF button = 2 THEN
  537.                 DefaultHeap:= DefaultHeap - DefaultHeap DIV 3
  538.               ELSE
  539.                 EXIT
  540.               END
  541.             END
  542.           END
  543.         END
  544.       END;
  545.       defbut:= 3
  546.     END (* LOOP *)
  547.   END service;
  548.  
  549. VAR msg: MessageBuffer;
  550.     menuID: CARDINAL;
  551.     button: CARDINAL;
  552.  
  553. BEGIN
  554.   (* Anmeldung beim GEM *)
  555.   InitApplication (ok);
  556.   IF NOT Accessory () THEN
  557.     Alert ('PrgLoad läuft nur als Accessory!')
  558.   ELSE
  559.     (* Initialisierung der globalen Variable *)
  560.     doingPexec:= FALSE;
  561.     DefaultHeap:= 16364;   (* Heap-Größe, wenn keine andere Angabe *)
  562.     GetHeapSize:= FALSE;
  563.     DidShowInfo:= FALSE;
  564.     Desktop:= ProcessID^;  (* Prozeß vom GEM/Desktop merken *)
  565.     stackhi:= ADR(regStack)+SIZE(regStack); (* Stack-Pointer für Reg.-Save *)
  566.     (* Stackframe für 'hdlGemdos' ermitteln *)
  567.     IF UseStackFrame () THEN stackFrameOffs:= 2 ELSE stackFrameOffs:= 0 END;
  568.     (* 'hdlGemdos' in TRAP #1 über XBRA einhängen *)
  569.     IF NOT XBRA.Installed (Kennung, $84 (* GEMDOS/TRAP#1 *), at) THEN
  570.       XBRA.Create (carrier, Kennung, CAST (ADDRESS, hdlGemdos), entry);
  571.       XBRA.Install (entry, at);
  572.       (* Zusammensetzen des Namens und Eintrag als Accessory *)
  573.       myName:= "  "+PrgName;
  574.       RegisterAcc (ADR (myName), menuID, ok);
  575.       UpdateWindow (TRUE);
  576.       readInfFile;
  577.       UpdateWindow (FALSE);
  578.       LOOP
  579.         MessageEvent (msg);
  580.         IF (msg.msgType = accOpen) THEN
  581.           service
  582.         END
  583.       END
  584.     END
  585.   END
  586. END PrgLoad.
  587.